@@ -8,7 +8,7 @@ Makefile
Makefile.old
blib/
cover_db/
-t/
+t/e2e/
lib/Devel/Cover/Inc.pm
pm_to_blib
*.out
@@ -1,5 +1,14 @@
Devel::Cover.pm history
+Release 0.69 - 28th August 2010
+ - Correctly report on C<my $x = $y || return> and other shortcuts.
+ - Put end to end tests in t/e2e.
+ - Add test for regexp eval fail (Florian Ragwitz).
+ - Fix some warnings from strict compilers (Florian Ragwitz).
+ - Allow tests to run in parallel (Florian Ragwitz).
+ - Test against 5.13.* development releases.
+ - We now require Test::More to run the tests.
+
Release 0.68 - 5th August 2010
- Fix gcov2perl to work with large numbers (Thomas Dorner) (rt 45028).
- Fix "gcov -l" include files (Thomas Dorner) (rt 44864).
@@ -438,8 +438,6 @@ static void cover_statement(pTHX_ OP *op)
static void cover_current_statement(pTHX)
{
- dMY_CXT;
-
#if CAN_PROFILE
cover_time(aTHX);
#endif
@@ -597,7 +595,6 @@ static void add_condition(pTHX_ SV *cond_ref, int value)
static void dump_conditions(pTHX)
{
- dMY_CXT;
HE *e;
MUTEX_LOCK(&DC_mutex);
@@ -641,8 +638,6 @@ static void dump_conditions(pTHX)
static OP *get_condition(pTHX)
{
- dMY_CXT;
-
SV **pc = hv_fetch(Pending_conditionals, get_key(PL_op), KEY_SZ, 0);
if (pc && SvROK(*pc))
@@ -675,7 +670,6 @@ static void finalise_conditions(pTHX)
* to collect that lost information.
*/
- dMY_CXT;
HE *e;
MUTEX_LOCK(&DC_mutex);
@@ -1222,7 +1216,6 @@ static SV *make_sv_object(pTHX_ SV *arg, SV *sv)
{
IV iv;
char *type;
- dMY_CXT;
iv = PTR2IV(sv);
type = svclassnames[SvTYPE(sv)];
@@ -46,6 +46,7 @@ META.yml
README
scanuncov
session.vim
+t/regexp/regexp_eval.t
tests/.uncoverable
tests/alias
tests/alias1
@@ -7,7 +7,7 @@
^blib
^pm_to_blib$
\.version$
-^t/
+^t/e2e/
\.gz$
\.c$
\.o$
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Devel-Cover
-version: 0.68
+version: 0.69
abstract: Code coverage metrics for Perl
author:
- Paul Johnson (pjcj@cpan.org)
@@ -13,6 +13,7 @@ build_requires:
requires:
Digest::MD5: 0
Storable: 0
+ Test::More: 0
no_index:
directory:
- t
@@ -19,8 +19,8 @@ use File::Copy;
$| = 1;
-my $Version = "0.68";
-my $Date = "5th August 2010";
+my $Version = "0.69";
+my $Date = "28th August 2010";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
@@ -86,9 +86,12 @@ close I or die "Cannot close lib/Devel/Cover/Inc.pm: $!";
print "Writing tests ........ ";
-unless (-d "t")
+for my $d (qw( t t/e2e ))
{
- mkdir "t" or die "Cannot mkdir t: $!";
+ unless (-d $d)
+ {
+ mkdir $d or die "Cannot mkdir $: $!";
+ }
}
opendir D, "tests" or die "Cannot opendir tests: $!";
@@ -100,11 +103,11 @@ for my $t (readdir D)
if ($t =~ /\.t/)
{
- copy("tests/$t", "t/$t") or die "Cannot copy tests/$t to t/$t: $!";
+ copy("tests/$t", "t/e2e/$t") or die "Cannot copy tests/$t to t/e2e/$t: $!";
next
}
- open T, ">t/a$t.t" or die "Cannot open t/a$t.t: $!";
+ open T, ">t/e2e/a$t.t" or die "Cannot open t/e2e/a$t.t: $!";
print T <<EOT;
#!$^X
@@ -127,7 +130,7 @@ use Devel::Cover::Test $Version;
Devel::Cover::Test->new("$t");
EOT
- close T or die "Cannot open t/a$t.t: $!";
+ close T or die "Cannot close t/e2e/a$t.t: $!";
}
closedir D or die "Cannot closedir tests: $!";
@@ -135,12 +138,12 @@ print "done\n\n";
my $e;
-print "checking for Storable.pm ........ ";
+print "checking for Storable ........ ";
$e = <<EOM;
-Storable.pm is required to store the coverage database. You can
-download Storable from CPAN.
+Storable is required to store the coverage database. You can download
+Storable from CPAN.
EOM
@@ -155,12 +158,12 @@ else
print "not found\n\n$e\n";
}
-print "checking for Digest::MD5.pm ........ ";
+print "checking for Digest::MD5 ........ ";
$e = <<EOM;
-Digest::MD5.pm is required to check whether covered files have changed.
-You can download Digest::MD5 from CPAN.
+Digest::MD5 is required to check whether covered files have changed. You can
+download Digest::MD5 from CPAN.
EOM
@@ -175,11 +178,31 @@ else
print "not found\n\n$e\n";
}
-print "checking for Template.pm version 2.00 ........ ";
+print "checking for Test::More ........ ";
+
+$e = <<EOM;
+
+Test::More is required to run the Devel::Cover tests. You can download
+Test::More from CPAN.
+
+EOM
+
+eval "use Test::More";
+if (my $m = $INC{"Test/More.pm"})
+{
+ my $v = eval { no warnings; $Test::More::VERSION };
+ print "$v $m\n";
+}
+else
+{
+ print "not found\n\n$e\n";
+}
+
+print "checking for Template version 2.00 ........ ";
$e = <<EOM;
-Template.pm 2.00 is required to run the some HTML backends to cover and
+Template 2.00 is required to run the some HTML backends to cover and
for cpancover. Unless you have specific requirements this should not be
a problem, but you will not be able to use these reports until you
install the Template Toolkit, available from CPAN. In the meantime you
@@ -224,17 +247,6 @@ else
print "checking for Perl::Tidy version 20060719 .... ";
-$e = <<EOM;
-
-One of PPI::HTML 1.07 or Perl::Tidy 20060719 is required to add syntax
-highlighting to some HTML backends to cover and for cpancover. Unless
-you have specific requirements this should not be a problem, but you will
-not be able to use syntax highlighting in these reports until you install
-PPI::HTML or Perl::Tidy, available from the CPAN. In the meantime you
-may continue to use the rest of Devel::Cover.
-
-EOM
-
eval "use Perl::Tidy";
if (my $m = $INC{"Perl/Tidy.pm"})
{
@@ -246,11 +258,11 @@ else
print "not found\n\n$e\n";
}
-print "checking for Pod::Coverage.pm version 0.06 ........ ";
+print "checking for Pod::Coverage version 0.06 ........ ";
$e = <<EOM;
-Pod::Coverage.pm 0.06 is required to do pod coverage. This will tell
+Pod::Coverage 0.06 is required to do pod coverage. This will tell
you how well you have documented your modules. Pod coverage will be
unavailable until you install this module, available from CPAN. In the
meantime, you may continue to use the rest of Devel::Cover.
@@ -289,11 +301,11 @@ else
print "not found\n\n$e\n";
}
-print "checking for Test::Differences.pm ........ ";
+print "checking for Test::Differences ........ ";
$e = <<EOM;
-Test::Differences.pm is used to display output from failed tests.
+Test::Differences is used to display output from failed tests.
Hopefully there won't be any failed tests, but if there are you will get
output that may not be a model of clarity. If you do get test failures
and you fancy helping me by debugging them, then you might like to
@@ -306,7 +318,7 @@ eval "use Test::Differences";
if (my $m = $INC{"Test/Differences.pm"})
{
my $v = eval { no warnings; $Test::Differences::VERSION };
- print "$v $m\n";
+ printf "%-8s $m\n", $v;
}
else
{
@@ -367,16 +379,18 @@ WriteMakefile
PREREQ_PM => {
Storable => 0,
"Digest::MD5" => 0,
+ "Test::More" => 0,
},
dist => { COMPRESS => "gzip --best --force" },
- clean => { FILES => join " ", "t/*" },
- depend => { distdir => "@files" },
+ test => { TESTS => "t/*/*.t" },
+ clean => { FILES => join " ", "t/e2e/*" },
+ depend => { distdir => "@files" },
realclean => $] < 5.008008 ?
{
FILES => "lib/Devel/Cover/Inc.pm",
- POSTOP => "\$(RM_RF) cover_db t"
+ POSTOP => "\$(RM_RF) cover_db t/e2e"
} :
- { FILES => "lib/Devel/Cover/Inc.pm cover_db t" },
+ { FILES => "lib/Devel/Cover/Inc.pm cover_db t/e2e" },
);
print "\n";
@@ -473,9 +487,7 @@ DB = cover_db
dump :
\t \$(PERL) -Mblib cover -dump_db \$(DB)
-FONT = 8x13
-FONT = -sun-screen-medium-r-normal-*-*-70-*-*-m-*-sun-fontspecific
-FONT = "Bitstream Vera Sans Mono 8"
+FONT = "Inconsolata 10"
GEOM = 260x85+0+0
diff : out
@@ -487,7 +499,7 @@ gold : pure_all
\t \$(PERL) create_gold \$(TEST)
all_test :
-\t exec \$(PERL) all_versions make test
+\t exec \$(PERL) all_versions test
all_gold :
\t rm -rf test_output
@@ -16,9 +16,12 @@ my $Options =
{
dry_run => 0,
ignore_failure => 0,
+ silent => 1,
version => [],
};
+my $Silent = "";
+
sub get_options
{
die "Bad option" unless
@@ -26,23 +29,28 @@ sub get_options
qw(
dry_run!
ignore_failure!
+ silent!
version=s
));
$Options->{version} =
[ map { ($_, "$_-thr") }
qw( 5.6.1 5.6.2
5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8 5.8.9
- 5.10.0 5.10.1 5.11.0 5.12.0 5.12.1 ) ]
+ 5.10.0 5.10.1 5.11.0 5.12.0 5.12.1 5.13.0 5.13.1 5.13.2
+ 5.13.3 5.13.4 ) ]
unless @{$Options->{version}};
+ $Silent = " >/dev/null 2>&1" if $Options->{silent};
$Options->{version} =
- [ grep eval { !system "perl$_ -v" }, @{$Options->{version}} ];
+ [ grep eval { !system "perl$_ -v$Silent" }, @{$Options->{version}} ];
+ print "Testing against: @{$Options->{version}}\n";
}
sub sys
{
- my ($command) = @_;
+ my ($command, $user) = @_;
print "$command\n";
return if $Options->{dry_run};
+ $command .= $Silent if $Options->{silent} && !$user;
my $ret = system $command;
die "command failed: $?" if $ret && !$Options->{ignore_failure};
}
@@ -53,10 +61,34 @@ my $command = "@ARGV" or die "Usage: $0 [-v version] command\n";
for my $v (@{$Options->{version}})
{
my $perl = "perl$v";
- sys "rm -rf t cover_db";
+ (my $c = $command) =~ s/=perl/$perl/g;
+ $c =~ s/=v/$v/g;
+ sys "rm -rf t/e2e";
sys "$perl Makefile.PL";
sys "make clean";
sys "$perl Makefile.PL";
sys "make";
- sys $command;
+ if ($c eq "test")
+ {
+ my ($dir) = grep -x "$_/$perl", split /:/, $ENV{PATH};
+ eval
+ {
+ my $l = readlink "$dir/$perl";
+ ($dir) = $l =~ m|(.*)/[^/]+|;
+ };
+ my ($prove) = grep -x,
+ map "$dir/prove$_",
+ "", $v, $v =~ /([\d.]+)/ ? $1 : "";
+ if ($prove)
+ {
+ my $cpus = 1;
+ eval { chomp ($cpus = `grep -c processor /proc/cpuinfo`); };
+ $cpus-- if $cpus > 4;
+ $c = "$prove -b -r -j$cpus t";
+ eval { sys $c, 1 };
+ next unless $@;
+ }
+ $c = "make test";
+ }
+ sys $c, 1;
}
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
use Config;
use Cwd "abs_path";
@@ -131,7 +131,7 @@ sub mb_test_command
sub main
{
- if ($INC{"Devel/Cover.pm"})
+ if (!$ENV{DEVEL_COVER_SELF} && $INC{"Devel/Cover.pm"})
{
my $err = "$0 shouldn't be run with coverage turned on.\n";
eval
@@ -444,7 +444,7 @@ See the BUGS file.
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
use Cwd ();
use Getopt::Long;
@@ -341,7 +341,7 @@ package Devel::Cover::Cpancover::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Template::Provider";
@@ -378,7 +378,7 @@ $Templates{html} = <<'EOT';
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.68
+This file was generated by Devel::Cover Version 0.69
Devel::Cover is copyright 2001-2010, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -479,7 +479,7 @@ The following exit values are returned:
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -12,14 +12,14 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use blib;
use Config;
exit if $Config{useithreads};
-use Devel::Cover::Test 0.68;
+use Devel::Cover::Test 0.69;
my @tests = @ARGV;
@@ -42,8 +42,9 @@ unless (@tests)
for my $test (@tests)
{
- my $t = -e "t/$test" ? "t/$test" :
- -e "t/a$test.t" ? "t/a$test.t" :
+ my $d = "t/e2e";
+ my $t = -e "$d/$test" ? "$d/$test" :
+ -e "$d/a$test.t" ? "$d/a$test.t" :
$test;
print STDERR "creating golden results for $test\n";
require $t or die "Can't require $t: $!";
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
use File::Path;
use File::Spec;
@@ -185,7 +185,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Annotation::Random;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use Getopt::Long;
@@ -103,7 +103,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Annotation::Svk;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use Getopt::Long;
use Digest::MD5;
@@ -175,7 +175,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Branch;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Criterion";
@@ -88,7 +88,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Branch";
@@ -50,7 +50,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_2;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_3;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_2;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_3;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_xor_4;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Condition";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,19 +10,19 @@ package Devel::Cover::Criterion;
use strict;
use warnings;
-our $VERSION = "0.68";
-
-use Devel::Cover::Statement 0.68;
-use Devel::Cover::Branch 0.68;
-use Devel::Cover::Condition 0.68;
-use Devel::Cover::Condition_or_2 0.68;
-use Devel::Cover::Condition_or_3 0.68;
-use Devel::Cover::Condition_and_2 0.68;
-use Devel::Cover::Condition_and_3 0.68;
-use Devel::Cover::Condition_xor_4 0.68;
-use Devel::Cover::Subroutine 0.68;
-use Devel::Cover::Time 0.68;
-use Devel::Cover::Pod 0.68;
+our $VERSION = "0.69";
+
+use Devel::Cover::Statement 0.69;
+use Devel::Cover::Branch 0.69;
+use Devel::Cover::Condition 0.69;
+use Devel::Cover::Condition_or_2 0.69;
+use Devel::Cover::Condition_or_3 0.69;
+use Devel::Cover::Condition_and_2 0.69;
+use Devel::Cover::Condition_and_3 0.69;
+use Devel::Cover::Condition_xor_4 0.69;
+use Devel::Cover::Subroutine 0.69;
+use Devel::Cover::Time 0.69;
+use Devel::Cover::Pod 0.69;
sub coverage { $_[0][0] }
sub information { $_[0][1] }
@@ -97,7 +97,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,9 +10,9 @@ package Devel::Cover::DB::File;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::Criterion 0.68;
+use Devel::Cover::Criterion 0.69;
sub calculate_summary
{
@@ -79,7 +79,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -16,7 +16,7 @@ use Storable;
use Devel::Cover::DB;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
our $AUTOLOAD;
sub new
@@ -323,7 +323,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,11 +10,11 @@ package Devel::Cover::DB;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::Criterion 0.68;
-use Devel::Cover::DB::File 0.68;
-use Devel::Cover::DB::Structure 0.68;
+use Devel::Cover::Criterion 0.69;
+use Devel::Cover::DB::File 0.69;
+use Devel::Cover::DB::Structure 0.69;
use Carp;
use File::Path;
@@ -1007,7 +1007,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -12,7 +12,7 @@ require 5.8.0; # My patches to B::Concise didn't get released till 5.8.0.
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
use B::Concise qw( set_style add_callback );
@@ -112,7 +112,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Pod;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Criterion";
@@ -66,7 +66,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -18,9 +18,9 @@ package Devel::Cover::Report::Compilation;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
# TODO - uncoverable code?
@@ -169,7 +169,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Report::Html;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Report::Html_minimal";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,10 +10,10 @@ package Devel::Cover::Report::Html_basic;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
-use Devel::Cover::Web 0.68 "write_file";
+use Devel::Cover::DB 0.69;
+use Devel::Cover::Web 0.69 "write_file";
use Getopt::Long;
use Template 2.00;
@@ -448,7 +448,7 @@ package Devel::Cover::Report::Html_basic::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Template::Provider";
@@ -468,7 +468,7 @@ $Templates{html} = <<'EOT';
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.68
+This file was generated by Devel::Cover Version 0.69
Devel::Cover is copyright 2001-2010, Paul Johnson (pjcj@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -769,7 +769,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -4,10 +4,10 @@ use strict;
use warnings;
use CGI;
use Getopt::Long;
-use Devel::Cover::DB 0.68;
-use Devel::Cover::Truth_Table 0.68;
+use Devel::Cover::DB 0.69;
+use Devel::Cover::Truth_Table 0.69;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
#-------------------------------------------------------------------------------
# Subroutine : get_coverage_for_line
@@ -261,7 +261,7 @@ sub print_html_header {
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.68
+This file was generated by Devel::Cover Version 0.69
Devel::Cover is copyright 2001-2010, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -776,7 +776,7 @@ Devel::Cover
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -2,10 +2,10 @@ package Devel::Cover::Report::Html_subtle;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
-use Devel::Cover::Truth_Table 0.68;
+use Devel::Cover::DB 0.69;
+use Devel::Cover::Truth_Table 0.69;
use Template 2.00;
use CGI;
@@ -386,7 +386,7 @@ package Devel::Cover::Report::Html_subtle::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Template::Provider";
@@ -404,7 +404,7 @@ sub fetch {
$Templates{html} = <<'EOT';
<?xml version="1.0" encoding="utf-8"?>
<!--
-This file was generated by Devel::Cover Version 0.68
+This file was generated by Devel::Cover Version 0.69
Devel::Cover is copyright 2001-2010, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -728,7 +728,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Sort;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
sub print_sort
{
@@ -95,7 +95,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Text;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
sub print_runs
{
@@ -313,7 +313,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -2,9 +2,9 @@ package Devel::Cover::Report::Text2;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
-use Devel::Cover::DB 0.68;
+use Devel::Cover::DB 0.69;
use Devel::Cover::Truth_Table;
my %format = (
@@ -191,7 +191,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Statement;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Criterion";
@@ -51,7 +51,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Subroutine;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Criterion";
@@ -50,7 +50,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,14 +10,14 @@ package Devel::Cover::Test;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use Carp;
use File::Spec;
use Test;
-use Devel::Cover::Inc 0.68;
+use Devel::Cover::Inc 0.69;
my $Test;
@@ -70,9 +70,11 @@ sub get_params
. " -merge 0 -coverage $self->{criteria} "
. ($self->{test_parameters} || "");
$self->{criteria} =~ s/-\w+//g;
+ $self->{cover_db} = "$Devel::Cover::Inc::Base/t/e2e/cover_db_$self->{test}/";
+ mkdir $self->{cover_db};
$self->{cover_parameters} = join(" ", map "-coverage $_",
split " ", $self->{criteria})
- . " -report text";
+ . " -report text " . $self->{cover_db};
$self->{cover_parameters} .= " -uncoverable_file $self->{uncoverable_file}"
if $self->{uncoverable_file};
$self->{skip} = $self->{skip_reason}
@@ -111,7 +113,7 @@ sub test_command
unless ($ENV{DEVEL_COVER_NO_COVERAGE})
{
$c .= " -MDevel::Cover=" .
- join(",", split ' ', $self->{test_parameters})
+ join(",", '-db', $self->{cover_db}, split ' ', $self->{test_parameters})
}
$c .= " " . shell_quote $self->test_file;
$c .= " " . $self->test_file_parameters;
@@ -10,7 +10,7 @@ package Devel::Cover::Time;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use base "Devel::Cover::Criterion";
@@ -71,7 +71,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -180,7 +180,7 @@ sub error {
package Devel::Cover::Truth_Table;
use warnings;
use strict;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
#-------------------------------------------------------------------------------
# Subroutine : new()
@@ -567,7 +567,7 @@ None that I'm aware of...
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENSE
@@ -163,7 +163,7 @@ basis for future research.
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -12,7 +12,7 @@ package Devel::Cover::Web;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use Exporter;
@@ -934,7 +934,7 @@ Huh?
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -10,13 +10,13 @@ package Devel::Cover;
use strict;
use warnings;
-our $VERSION = "0.68";
+our $VERSION = "0.69";
use DynaLoader ();
our @ISA = "DynaLoader";
-use Devel::Cover::DB 0.68;
-use Devel::Cover::Inc 0.68;
+use Devel::Cover::DB 0.69;
+use Devel::Cover::Inc 0.69;
use B qw( class ppname main_cv main_start main_root walksymtable OPf_KIDS );
use B::Debug;
@@ -70,6 +70,7 @@ my $Sub_count; # Count for multiple subs on same line.
my $Coverage; # Raw coverage data.
my $Structure; # Structure of the files.
+my $Self_coverage; # Coverage of Devel::Cover
my %Criteria; # Names of coverage criteria.
my %Coverage; # Coverage criteria to collect.
@@ -77,6 +78,10 @@ my %Coverage_options; # Options for overage criteria.
my %Run; # Data collected from the run.
+my $Const_right = qr/^(?:const|s?refgen|gelem|die|undef|bless|anon(?:list|hash)|
+ scalar|return|last|next|redo|goto)$/x;
+ # constant ops
+
use vars '$File', # Last filename we saw. (localised)
'$Line', # Last line number we saw. (localised)
'$Collect', # Whether or not we are collecting
@@ -157,7 +162,32 @@ if (0 && $Config{useithreads})
BEGIN { @Inc = @Devel::Cover::Inc::Inc; @Ignore = ("/Devel/Cover[./]") }
# BEGIN { $^P = 0x004 | 0x010 | 0x100 | 0x200 }
# BEGIN { $^P = 0x004 | 0x100 | 0x200 }
-BEGIN { $^P = 0x004 | 0x100 }
+BEGIN { $^P |= 0x004 | 0x100 }
+BEGIN
+{
+ if ($ENV{DEVEL_COVER_SELF})
+ {
+ @Ignore = ();
+ $^P = 0x73f;
+ *DB::DB = sub
+ {
+ my (undef, $f, $l) = caller;
+
+ # print STDERR "$f:$l\n" if $f =~ /DB/;
+ return unless $f =~ /Devel\/Cover/;
+ my $nf = normalised_file($f);
+ $Self_coverage->{$nf}{$l}++;
+ return;
+
+ no strict "refs";
+ my $code = \@{"::_<$f"};
+ my $line = defined $code->[$l] ? $code->[$l] : "";
+ chomp $line;
+ print STDERR "$f:$l: $line\n";
+
+ };
+ }
+}
{
sub check
@@ -728,6 +758,8 @@ sub add_statement_cover
$Run{digests}{$File} ||= $Structure->set_file($File);
my $key = get_key($op);
my $val = $Coverage->{statement}{$key} || 0;
+ $val = $Self_coverage->{$File}{$Line} || 0
+ if $ENV{DEVEL_COVER_SELF} && exists $Self_coverage->{$File};
my ($n, $new) = $Structure->add_count("statement");
$Structure->add_statement($File, $Line) if $new;
$Run{count}{$File}{statement}[$n] += $val;
@@ -809,10 +841,14 @@ sub add_condition_cover
my $key = get_key($op);
# print STDERR "Condition cover $$op from $File:$Line\n";
+ # print STDERR "left: [$left]\nright: [$right]\n";
+ # use Carp "cluck"; cluck("from here");
my $type = $op->name;
+ # print STDERR "type: [$type]\n";
$type =~ s/assign$//;
$type = "or" if $type eq "dor";
+ # print STDERR "type: [$type]\n";
my $c = $Coverage->{condition}{$key};
@@ -827,11 +863,11 @@ sub add_condition_cover
$name = $r->first->name if $name eq "sassign";
# TODO - exec? any others?
# print STDERR "Name [$name]\n";
- if ($c->[5] || $name =~
- /^const|s?refgen|gelem|die|undef|bless|anon(?:list|hash)|scalar$/)
+ if ($c->[5] || $name =~ $Const_right)
{
$c = [ $c->[3], $c->[1] + $c->[2] ];
$count = 2;
+ # print STDERR "Special short circuit\n";
}
else
{
@@ -989,9 +1025,12 @@ sub logop
my ($op, $cx, $lowop, $lowprec, $highop, $highprec, $blockname) = @_;
my $left = $op->first;
my $right = $op->first->sibling;
+ # print STDERR "left [$left], right [$right]\n";
my ($file, $line) = ($File, $Line);
+
if ($cx < 1 && is_scope($right) && $blockname && $self->{expand} < 7)
{
+ # print STDERR 'if ($a) {$b}', "\n";
# if ($a) {$b}
{
# local $Collect;
@@ -1004,6 +1043,7 @@ sub logop
}
elsif ($cx < 1 && $blockname && !$self->{parens} && $self->{expand} < 7)
{
+ # print STDERR '$b if $a', "\n";
# $b if $a
{
# local $Collect;
@@ -1016,18 +1056,21 @@ sub logop
}
elsif ($cx > $lowprec && $highop)
{
+ # print STDERR '$a && $b', "\n";
# $a && $b
{
- # local $Collect;
+ local $Collect;
$left = $self->deparse_binop_left ($op, $left, $highprec);
$right = $self->deparse_binop_right($op, $right, $highprec);
}
+ # print STDERR "left [$left], right [$right]\n";
add_condition_cover($op, $highop, $left, $right)
unless $Seen{condition}{$$op}++;
return $self->maybe_parens("$left $highop $right", $cx, $highprec)
}
else
{
+ # print STDERR '$a and $b', "\n";
# $a and $b
{
# local $Collect;
@@ -1442,7 +1485,7 @@ See the BUGS file. And the TODO file.
=head1 VERSION
-Version 0.68 - 5th August 2010
+Version 0.69 - 28th August 2010
=head1 LICENCE
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+# This tests against what is basically a perl bug. When evaluating
+# code within a regular expression, the state of the regular
+# expression engine may not be altered, i.e. no regex match may be
+# performed within a regular expression.
+#
+# The following code doesn't do that, but entering the eval within the
+# regular expression involves a nextstate OP. We hook, among other
+# things, into those opcodes, and execute some of our own
+# code. Devel::Cover::use_file, to be precise. That function currently
+# uses regular expressions, and therefore breaks shit.
+#
+# We currently avoid calling use_file at all within regexp evals. This
+# test makes sure we actually do, and will yell at us if we ever start
+# doing it again.
+#
+# CPAN RT#57174 is the corresponding Devel::Cover bug. This still
+# needs to be submitted to and fixed in perl core.
+
+'x' =~ m{ (?: ((??{ 'x' })) )? }x;
+
+# on debugging perls we'd already have hit an assertion failure
+# here. We don't do "pass 'no assertion fail'" tho. I don't know if
+# that might mess up $1 for the next test. We also have to use $1
+# instead of capturing in a lexical, as that tends to fail rather
+# differently.
+
+# on non-debugging perls, the above match tends to succeed, and only
+# rarely segfaults. Therefore we also make sure that the result is
+# correct. If we hit the bug, it tends to either contain complete
+# garbage, (parts of) some random constants from the perl interpreter,
+# or segfaults completely when invoking the get magic on it.
+
+is $1, 'x';
@@ -4,8 +4,8 @@ Reading database from ...
------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_branch 82.5 79.3 19.1 100.0 68.7
-Total 82.5 79.3 19.1 100.0 68.7
+tests/cond_branch 85.3 79.3 32.9 100.0 73.0
+Total 85.3 79.3 32.9 100.0 73.0
------------------------------------------ ------ ------ ------ ------ ------
@@ -322,50 +322,119 @@ line err stmt bran cond sub code
273 *** 4 0 4 shift xor return;
274 *** 0 $x[44]++;
275 },
-276 1 );
-277
-278 1 for my $s (@s)
- 3
-279 {
-280 3 for my $y (0, 1)
- 6
-281 {
-282 6 $s->($y)
-283 }
-284
-285 3 for my $y (1, 0)
- 6
-286 {
-287 6 $s->($y)
-288 }
-289 }
-290
-291
-292 1 my ($a, $b) = (0, 1);
-293
-294 *** 1 50 33 if ($a && $b)
+276
+277 sub
+278 {
+279 4 100 4 my $x = shift || return;
+280 2 $x[45]++;
+281 },
+282
+283 sub
+284 {
+285 4 100 4 my $x = shift && return;
+286 2 $x[46]++;
+287 },
+288
+289 sub
+290 {
+291 4 4 my $x = shift;
+292 4 for my $y (1 .. 2)
+ 4
+293 {
+294 6 100 my $z = $x || last;
+295 4 $x[47]++;
+296 }
+297 },
+298
+299 sub
+300 {
+301 4 4 my $x = shift;
+302 4 for my $y (1 .. 2)
+ 8
+303 {
+304 8 100 my $z = $x || next;
+305 4 $x[48]++;
+306 }
+307 },
+308
+309 sub
+310 {
+311 4 4 my $x = shift;
+312 4 for my $y (1 .. 2)
+ 8
+313 {
+314 10 100 my $z = $x++ || redo;
+315 8 $x[49]++;
+316 }
+317 },
+318
+319 sub
+320 {
+321 4 4 my $x = shift;
+322 4 for my $y (1 .. 2)
+ 4
+323 {
+324 6 100 my $z = $x || goto GR;
+325 4 $x[50]++;
+326 }
+327 GR:
+328 4 },
+329
+330 sub
+331 {
+332 4 4 my $x = shift;
+333 4 for my $y (1 .. 2)
+ 8
+334 {
+335 8 100 eval { my $z = $x || die };
+ 8
+336 8 $x[51]++;
+337 }
+338 },
+339 1 );
+340
+341 1 for my $s (@s)
+ 10
+342 {
+343 10 for my $y (0, 1)
+ 20
+344 {
+345 20 $s->($y)
+346 }
+347
+348 10 for my $y (1, 0)
+ 20
+349 {
+350 20 $s->($y)
+351 }
+352 }
+353
+354
+355 1 my ($a, $b) = (0, 1);
+356
+357 *** 1 50 33 if ($a && $b)
*** 50 33
*** 50 50
-295 {
-296 *** 0 print "path 1\n";
-297 }
-298 elsif (!$a && !$b)
-299 {
-300 *** 0 print "path 2\n";
-301 }
-302 elsif ($b || 0)
-303 {
-304 1 print "path 3\n";
-305 *** 1 50 33 if (!$b || $a)
+358 {
+359 *** 0 print "path 1\n";
+360 }
+361 elsif (!$a && !$b)
+362 {
+363 *** 0 print "path 2\n";
+364 }
+365 elsif ($b || 0)
+366 {
+367 1 print "path 3\n";
+368 *** 1 50 33 if (!$b || $a)
*** 50 33
-306 {
-307 *** 0 print "path 4\n";
-308 }
-309 elsif (!$a && $b)
-310 {
-311 1 print "path 5\n";
-312 }
-313 }
+369 {
+370 *** 0 print "path 4\n";
+371 }
+372 elsif (!$a && $b)
+373 {
+374 1 print "path 5\n";
+375 }
+376 }
Branches
@@ -414,16 +483,22 @@ line err % true false branch
249 100 1 2 if $z > 1
260 100 2 2 unless shift @_
266 100 2 2 if shift @_
-294 *** 50 0 1 if ($a and $b) { }
+357 *** 50 0 1 if ($a and $b) { }
*** 50 0 1 elsif (not $a and not $b) { }
*** 50 1 0 elsif ($b or 0) { }
-305 *** 50 0 1 if (not $b or $a) { }
+368 *** 50 0 1 if (not $b or $a) { }
*** 50 1 0 elsif (not $a and $b) { }
Conditions
----------
+and 2 conditions
+
+line err % l !l expr
+----- --- ------ ------ ------ ----
+285 100 2 2 shift @_ && return
+
and 3 conditions
line err % !l l&&!r l&&r expr
@@ -432,15 +507,21 @@ line err % !l l&&!r l&&r expr
51 *** 33 4 0 0 $y and $z
68 *** 33 4 0 0 $y and $z
*** 33 4 0 0 $y and $z
-294 *** 33 1 0 0 $a and $b
+357 *** 33 1 0 0 $a and $b
*** 33 0 1 0 not $a and not $b
-305 *** 33 0 0 1 not $a and $b
+368 *** 33 0 0 1 not $a and $b
or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-294 *** 50 1 0 $b or 0
+279 100 2 2 shift @_ || return
+294 100 4 2 $x || last
+304 100 4 4 $x || next
+314 100 8 2 $x++ || redo
+324 100 4 2 $x || goto GR
+335 100 4 4 $x || die
+357 *** 50 1 0 $b or 0
or 3 conditions
@@ -448,7 +529,7 @@ line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
27 *** 66 0 2 2 $y or $z
51 *** 66 0 2 2 $y or $z
-305 *** 33 0 0 1 not $b or $a
+368 *** 33 0 0 1 not $b or $a
xor 4 conditions
@@ -473,5 +554,12 @@ Subroutine Count Location
__ANON__ 4 tests/cond_branch:260
__ANON__ 4 tests/cond_branch:266
__ANON__ 4 tests/cond_branch:273
+__ANON__ 4 tests/cond_branch:279
+__ANON__ 4 tests/cond_branch:285
+__ANON__ 4 tests/cond_branch:291
+__ANON__ 4 tests/cond_branch:301
+__ANON__ 4 tests/cond_branch:311
+__ANON__ 4 tests/cond_branch:321
+__ANON__ 4 tests/cond_branch:332
@@ -4,8 +4,8 @@ Reading database from ...
------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_branch 85.4 79.3 19.1 100.0 72.4
-Total 85.4 79.3 19.1 100.0 72.4
+tests/cond_branch 87.4 79.3 32.9 100.0 75.8
+Total 87.4 79.3 32.9 100.0 75.8
------------------------------------------ ------ ------ ------ ------ ------
@@ -344,50 +344,119 @@ line err stmt bran cond sub code
273 *** 4 0 4 shift xor return;
274 *** 0 $x[44]++;
275 },
-276 1 );
-277
-278 1 for my $s (@s)
- 3
-279 {
-280 3 for my $y (0, 1)
- 6
-281 {
-282 6 $s->($y)
-283 }
-284
-285 3 for my $y (1, 0)
- 6
-286 {
-287 6 $s->($y)
-288 }
-289 }
-290
-291
-292 1 my ($a, $b) = (0, 1);
-293
-294 *** 1 50 33 if ($a && $b)
+276
+277 sub
+278 {
+279 4 100 4 my $x = shift || return;
+280 2 $x[45]++;
+281 },
+282
+283 sub
+284 {
+285 4 100 4 my $x = shift && return;
+286 2 $x[46]++;
+287 },
+288
+289 sub
+290 {
+291 4 4 my $x = shift;
+292 4 for my $y (1 .. 2)
+ 4
+293 {
+294 6 100 my $z = $x || last;
+295 4 $x[47]++;
+296 }
+297 },
+298
+299 sub
+300 {
+301 4 4 my $x = shift;
+302 4 for my $y (1 .. 2)
+ 8
+303 {
+304 8 100 my $z = $x || next;
+305 4 $x[48]++;
+306 }
+307 },
+308
+309 sub
+310 {
+311 4 4 my $x = shift;
+312 4 for my $y (1 .. 2)
+ 8
+313 {
+314 10 100 my $z = $x++ || redo;
+315 8 $x[49]++;
+316 }
+317 },
+318
+319 sub
+320 {
+321 4 4 my $x = shift;
+322 4 for my $y (1 .. 2)
+ 4
+323 {
+324 6 100 my $z = $x || goto GR;
+325 4 $x[50]++;
+326 }
+327 GR:
+328 4 },
+329
+330 sub
+331 {
+332 4 4 my $x = shift;
+333 4 for my $y (1 .. 2)
+ 8
+334 {
+335 8 100 eval { my $z = $x || die };
+ 8
+336 8 $x[51]++;
+337 }
+338 },
+339 1 );
+340
+341 1 for my $s (@s)
+ 10
+342 {
+343 10 for my $y (0, 1)
+ 20
+344 {
+345 20 $s->($y)
+346 }
+347
+348 10 for my $y (1, 0)
+ 20
+349 {
+350 20 $s->($y)
+351 }
+352 }
+353
+354
+355 1 my ($a, $b) = (0, 1);
+356
+357 *** 1 50 33 if ($a && $b)
*** 50 33
*** 50 50
-295 {
-296 *** 0 print "path 1\n";
-297 }
-298 elsif (!$a && !$b)
-299 {
-300 *** 0 print "path 2\n";
-301 }
-302 elsif ($b || 0)
-303 {
-304 1 print "path 3\n";
-305 *** 1 50 33 if (!$b || $a)
+358 {
+359 *** 0 print "path 1\n";
+360 }
+361 elsif (!$a && !$b)
+362 {
+363 *** 0 print "path 2\n";
+364 }
+365 elsif ($b || 0)
+366 {
+367 1 print "path 3\n";
+368 *** 1 50 33 if (!$b || $a)
*** 50 33
-306 {
-307 *** 0 print "path 4\n";
-308 }
-309 elsif (!$a && $b)
-310 {
-311 1 print "path 5\n";
-312 }
-313 }
+369 {
+370 *** 0 print "path 4\n";
+371 }
+372 elsif (!$a && $b)
+373 {
+374 1 print "path 5\n";
+375 }
+376 }
Branches
@@ -436,16 +505,22 @@ line err % true false branch
249 100 1 2 if $z > 1
260 100 2 2 unless shift @_
266 100 2 2 if shift @_
-294 *** 50 0 1 if ($a and $b) { }
+357 *** 50 0 1 if ($a and $b) { }
*** 50 0 1 elsif (not $a and not $b) { }
*** 50 1 0 elsif ($b or 0) { }
-305 *** 50 0 1 if (not $b or $a) { }
+368 *** 50 0 1 if (not $b or $a) { }
*** 50 1 0 elsif (not $a and $b) { }
Conditions
----------
+and 2 conditions
+
+line err % l !l expr
+----- --- ------ ------ ------ ----
+285 100 2 2 shift @_ && return
+
and 3 conditions
line err % !l l&&!r l&&r expr
@@ -454,15 +529,21 @@ line err % !l l&&!r l&&r expr
51 *** 33 4 0 0 $y and $z
68 *** 33 4 0 0 $y and $z
*** 33 4 0 0 $y and $z
-294 *** 33 1 0 0 $a and $b
+357 *** 33 1 0 0 $a and $b
*** 33 0 1 0 not $a and not $b
-305 *** 33 0 0 1 not $a and $b
+368 *** 33 0 0 1 not $a and $b
or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-294 *** 50 1 0 $b or 0
+279 100 2 2 shift @_ || return
+294 100 4 2 $x || last
+304 100 4 4 $x || next
+314 100 8 2 $x++ || redo
+324 100 4 2 $x || goto GR
+335 100 4 4 $x || die
+357 *** 50 1 0 $b or 0
or 3 conditions
@@ -470,7 +551,7 @@ line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
27 *** 66 0 2 2 $y or $z
51 *** 66 0 2 2 $y or $z
-305 *** 33 0 0 1 not $b or $a
+368 *** 33 0 0 1 not $b or $a
xor 4 conditions
@@ -506,5 +587,12 @@ BEGIN 1 tests/cond_branch:99
__ANON__ 4 tests/cond_branch:260
__ANON__ 4 tests/cond_branch:266
__ANON__ 4 tests/cond_branch:273
+__ANON__ 4 tests/cond_branch:279
+__ANON__ 4 tests/cond_branch:285
+__ANON__ 4 tests/cond_branch:291
+__ANON__ 4 tests/cond_branch:301
+__ANON__ 4 tests/cond_branch:311
+__ANON__ 4 tests/cond_branch:321
+__ANON__ 4 tests/cond_branch:332
@@ -4,8 +4,8 @@ Reading database from ...
------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_branch 88.8 79.3 19.1 100.0 73.0
-Total 88.8 79.3 19.1 100.0 73.0
+tests/cond_branch 90.3 79.3 32.9 100.0 76.2
+Total 90.3 79.3 32.9 100.0 76.2
------------------------------------------ ------ ------ ------ ------ ------
@@ -318,47 +318,111 @@ line err stmt bran cond sub code
273 *** 4 0 4 shift xor return;
274 *** 0 $x[44]++;
275 },
-276 1 );
-277
-278 1 for my $s (@s)
-279 {
-280 3 for my $y (0, 1)
-281 {
-282 6 $s->($y)
-283 }
-284
-285 3 for my $y (1, 0)
-286 {
-287 6 $s->($y)
-288 }
-289 }
-290
-291
-292 1 my ($a, $b) = (0, 1);
-293
-294 *** 1 50 33 if ($a && $b)
+276
+277 sub
+278 {
+279 4 100 4 my $x = shift || return;
+280 2 $x[45]++;
+281 },
+282
+283 sub
+284 {
+285 4 100 4 my $x = shift && return;
+286 2 $x[46]++;
+287 },
+288
+289 sub
+290 {
+291 4 4 my $x = shift;
+292 4 for my $y (1 .. 2)
+293 {
+294 6 100 my $z = $x || last;
+295 4 $x[47]++;
+296 }
+297 },
+298
+299 sub
+300 {
+301 4 4 my $x = shift;
+302 4 for my $y (1 .. 2)
+303 {
+304 8 100 my $z = $x || next;
+305 4 $x[48]++;
+306 }
+307 },
+308
+309 sub
+310 {
+311 4 4 my $x = shift;
+312 4 for my $y (1 .. 2)
+313 {
+314 10 100 my $z = $x++ || redo;
+315 8 $x[49]++;
+316 }
+317 },
+318
+319 sub
+320 {
+321 4 4 my $x = shift;
+322 4 for my $y (1 .. 2)
+323 {
+324 6 100 my $z = $x || goto GR;
+325 4 $x[50]++;
+326 }
+327 GR:
+328 4 },
+329
+330 sub
+331 {
+332 4 4 my $x = shift;
+333 4 for my $y (1 .. 2)
+334 {
+335 8 100 eval { my $z = $x || die };
+ 8
+336 8 $x[51]++;
+337 }
+338 },
+339 1 );
+340
+341 1 for my $s (@s)
+342 {
+343 10 for my $y (0, 1)
+344 {
+345 20 $s->($y)
+346 }
+347
+348 10 for my $y (1, 0)
+349 {
+350 20 $s->($y)
+351 }
+352 }
+353
+354
+355 1 my ($a, $b) = (0, 1);
+356
+357 *** 1 50 33 if ($a && $b)
*** 50 33
*** 50 50
-295 {
-296 *** 0 print "path 1\n";
-297 }
-298 elsif (!$a && !$b)
-299 {
-300 *** 0 print "path 2\n";
-301 }
-302 elsif ($b || 0)
-303 {
-304 1 print "path 3\n";
-305 *** 1 50 33 if (!$b || $a)
+358 {
+359 *** 0 print "path 1\n";
+360 }
+361 elsif (!$a && !$b)
+362 {
+363 *** 0 print "path 2\n";
+364 }
+365 elsif ($b || 0)
+366 {
+367 1 print "path 3\n";
+368 *** 1 50 33 if (!$b || $a)
*** 50 33
-306 {
-307 *** 0 print "path 4\n";
-308 }
-309 elsif (!$a && $b)
-310 {
-311 1 print "path 5\n";
-312 }
-313 }
+369 {
+370 *** 0 print "path 4\n";
+371 }
+372 elsif (!$a && $b)
+373 {
+374 1 print "path 5\n";
+375 }
+376 }
Branches
@@ -407,16 +471,22 @@ line err % true false branch
249 100 1 2 if $z > 1
260 100 2 2 unless shift @_
266 100 2 2 if shift @_
-294 *** 50 0 1 if ($a and $b) { }
+357 *** 50 0 1 if ($a and $b) { }
*** 50 0 1 elsif (not $a and not $b) { }
*** 50 1 0 elsif ($b or 0) { }
-305 *** 50 0 1 if (not $b or $a) { }
+368 *** 50 0 1 if (not $b or $a) { }
*** 50 1 0 elsif (not $a and $b) { }
Conditions
----------
+and 2 conditions
+
+line err % l !l expr
+----- --- ------ ------ ------ ----
+285 100 2 2 shift @_ && return
+
and 3 conditions
line err % !l l&&!r l&&r expr
@@ -425,15 +495,21 @@ line err % !l l&&!r l&&r expr
51 *** 33 4 0 0 $y and $z
68 *** 33 4 0 0 $y and $z
*** 33 4 0 0 $y and $z
-294 *** 33 1 0 0 $a and $b
+357 *** 33 1 0 0 $a and $b
*** 33 0 1 0 not $a and not $b
-305 *** 33 0 0 1 not $a and $b
+368 *** 33 0 0 1 not $a and $b
or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-294 *** 50 1 0 $b or 0
+279 100 2 2 shift @_ || return
+294 100 4 2 $x || last
+304 100 4 4 $x || next
+314 100 8 2 $x++ || redo
+324 100 4 2 $x || goto GR
+335 100 4 4 $x || die
+357 *** 50 1 0 $b or 0
or 3 conditions
@@ -441,7 +517,7 @@ line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
27 *** 66 0 2 2 $y or $z
51 *** 66 0 2 2 $y or $z
-305 *** 33 0 0 1 not $b or $a
+368 *** 33 0 0 1 not $b or $a
xor 4 conditions
@@ -477,5 +553,12 @@ BEGIN 1 tests/cond_branch:99
__ANON__ 4 tests/cond_branch:260
__ANON__ 4 tests/cond_branch:266
__ANON__ 4 tests/cond_branch:273
+__ANON__ 4 tests/cond_branch:279
+__ANON__ 4 tests/cond_branch:285
+__ANON__ 4 tests/cond_branch:291
+__ANON__ 4 tests/cond_branch:301
+__ANON__ 4 tests/cond_branch:311
+__ANON__ 4 tests/cond_branch:321
+__ANON__ 4 tests/cond_branch:332
@@ -4,8 +4,8 @@ Reading database from ...
------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_branch 88.8 79.3 19.1 100.0 73.0
-Total 88.8 79.3 19.1 100.0 73.0
+tests/cond_branch 90.3 79.3 32.9 100.0 76.2
+Total 90.3 79.3 32.9 100.0 76.2
------------------------------------------ ------ ------ ------ ------ ------
@@ -318,47 +318,111 @@ line err stmt bran cond sub code
273 *** 4 0 4 shift xor return;
274 *** 0 $x[44]++;
275 },
-276 1 );
-277
-278 1 for my $s (@s)
-279 {
-280 3 for my $y (0, 1)
-281 {
-282 6 $s->($y)
-283 }
-284
-285 3 for my $y (1, 0)
-286 {
-287 6 $s->($y)
-288 }
-289 }
-290
-291
-292 1 my ($a, $b) = (0, 1);
-293
-294 *** 1 50 33 if ($a && $b)
+276
+277 sub
+278 {
+279 4 100 4 my $x = shift || return;
+280 2 $x[45]++;
+281 },
+282
+283 sub
+284 {
+285 4 100 4 my $x = shift && return;
+286 2 $x[46]++;
+287 },
+288
+289 sub
+290 {
+291 4 4 my $x = shift;
+292 4 for my $y (1 .. 2)
+293 {
+294 6 100 my $z = $x || last;
+295 4 $x[47]++;
+296 }
+297 },
+298
+299 sub
+300 {
+301 4 4 my $x = shift;
+302 4 for my $y (1 .. 2)
+303 {
+304 8 100 my $z = $x || next;
+305 4 $x[48]++;
+306 }
+307 },
+308
+309 sub
+310 {
+311 4 4 my $x = shift;
+312 4 for my $y (1 .. 2)
+313 {
+314 10 100 my $z = $x++ || redo;
+315 8 $x[49]++;
+316 }
+317 },
+318
+319 sub
+320 {
+321 4 4 my $x = shift;
+322 4 for my $y (1 .. 2)
+323 {
+324 6 100 my $z = $x || goto GR;
+325 4 $x[50]++;
+326 }
+327 GR:
+328 4 },
+329
+330 sub
+331 {
+332 4 4 my $x = shift;
+333 4 for my $y (1 .. 2)
+334 {
+335 8 100 eval { my $z = $x || die };
+ 8
+336 8 $x[51]++;
+337 }
+338 },
+339 1 );
+340
+341 1 for my $s (@s)
+342 {
+343 10 for my $y (0, 1)
+344 {
+345 20 $s->($y)
+346 }
+347
+348 10 for my $y (1, 0)
+349 {
+350 20 $s->($y)
+351 }
+352 }
+353
+354
+355 1 my ($a, $b) = (0, 1);
+356
+357 *** 1 50 33 if ($a && $b)
*** 50 33
*** 50 50
-295 {
-296 *** 0 print "path 1\n";
-297 }
-298 elsif (!$a && !$b)
-299 {
-300 *** 0 print "path 2\n";
-301 }
-302 elsif ($b || 0)
-303 {
-304 1 print "path 3\n";
-305 *** 1 50 33 if (!$b || $a)
+358 {
+359 *** 0 print "path 1\n";
+360 }
+361 elsif (!$a && !$b)
+362 {
+363 *** 0 print "path 2\n";
+364 }
+365 elsif ($b || 0)
+366 {
+367 1 print "path 3\n";
+368 *** 1 50 33 if (!$b || $a)
*** 50 33
-306 {
-307 *** 0 print "path 4\n";
-308 }
-309 elsif (!$a && $b)
-310 {
-311 1 print "path 5\n";
-312 }
-313 }
+369 {
+370 *** 0 print "path 4\n";
+371 }
+372 elsif (!$a && $b)
+373 {
+374 1 print "path 5\n";
+375 }
+376 }
Branches
@@ -407,16 +471,22 @@ line err % true false branch
249 100 1 2 if $z > 1
260 100 2 2 unless shift @_
266 100 2 2 if shift @_
-294 *** 50 0 1 if ($a and $b) { }
+357 *** 50 0 1 if ($a and $b) { }
*** 50 0 1 elsif (not $a || $b) { }
*** 50 1 0 elsif ($b or 0) { }
-305 *** 50 0 1 if (not $b or $a) { }
+368 *** 50 0 1 if (not $b or $a) { }
*** 50 1 0 elsif (not $a and $b) { }
Conditions
----------
+and 2 conditions
+
+line err % l !l expr
+----- --- ------ ------ ------ ----
+285 100 2 2 shift @_ && return
+
and 3 conditions
line err % !l l&&!r l&&r expr
@@ -425,14 +495,20 @@ line err % !l l&&!r l&&r expr
51 *** 33 4 0 0 $y and $z
68 *** 33 4 0 0 $y and $z
*** 33 4 0 0 $y and $z
-294 *** 33 1 0 0 $a and $b
-305 *** 33 0 0 1 not $a and $b
+357 *** 33 1 0 0 $a and $b
+368 *** 33 0 0 1 not $a and $b
or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-294 *** 50 1 0 $b or 0
+279 100 2 2 shift @_ || return
+294 100 4 2 $x || last
+304 100 4 4 $x || next
+314 100 8 2 $x++ || redo
+324 100 4 2 $x || goto GR
+335 100 4 4 $x || die
+357 *** 50 1 0 $b or 0
or 3 conditions
@@ -440,8 +516,8 @@ line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
27 *** 66 0 2 2 $y or $z
51 *** 66 0 2 2 $y or $z
-294 *** 33 0 1 0 $a || $b
-305 *** 33 0 0 1 not $b or $a
+357 *** 33 0 1 0 $a || $b
+368 *** 33 0 0 1 not $b or $a
xor 4 conditions
@@ -477,5 +553,12 @@ BEGIN 1 tests/cond_branch:99
__ANON__ 4 tests/cond_branch:260
__ANON__ 4 tests/cond_branch:266
__ANON__ 4 tests/cond_branch:273
+__ANON__ 4 tests/cond_branch:279
+__ANON__ 4 tests/cond_branch:285
+__ANON__ 4 tests/cond_branch:291
+__ANON__ 4 tests/cond_branch:301
+__ANON__ 4 tests/cond_branch:311
+__ANON__ 4 tests/cond_branch:321
+__ANON__ 4 tests/cond_branch:332
@@ -127,7 +127,7 @@ line err % true false branch
41 *** 50 0 11 unless $y or $x[0]++
45 *** 50 11 0 unless $z
53 *** 50 0 11 if ($z) { }
-87 *** 50 0 11 if exists ->{Deparse error: Can't locate object method "name" via package "B::NULL" (perhaps you forgot to load "B::NULL"?) at /usr/local/pkg/perl/default/perl-5.6.1/lib/5.6.1/i686-linux/B/Deparse.pm line 409.
+87 *** 50 0 11 if exists ->{Deparse error: Can't locate object method "name" via package "B::NULL" (perhaps you forgot to load "B::NULL"?) at /usr/local/pkg/perl/default/perl-5.6.1/lib/5.6.1/x86_64-linux/B/Deparse.pm line 409.
}
@@ -127,7 +127,7 @@ line err % true false branch
41 *** 50 0 11 unless $y or $x[0]++
45 *** 50 11 0 unless $z
53 *** 50 0 11 if ($z) { }
-87 *** 50 0 11 if exists ->{Deparse error: Can't locate object method "name" via package "B::NULL" (perhaps you forgot to load "B::NULL"?) at /usr/local/pkg/perl/default/perl-5.6.2/lib/5.6.2/i686-linux/B/Deparse.pm line 409.
+87 *** 50 0 11 if exists ->{Deparse error: Can't locate object method "name" via package "B::NULL" (perhaps you forgot to load "B::NULL"?) at /usr/local/pkg/perl/default/perl-5.6.2/lib/5.6.2/x86_64-linux/B/Deparse.pm line 409.
}
@@ -12,8 +12,8 @@ use warnings;
use File::Copy;
-use Devel::Cover::Inc 0.68;
-use Devel::Cover::Test 0.68;
+use Devel::Cover::Inc 0.69;
+use Devel::Cover::Test 0.69;
my $base = $Devel::Cover::Inc::Base;
@@ -273,6 +273,69 @@ my @s =
shift xor return;
$x[44]++;
},
+
+ sub
+ {
+ my $x = shift || return;
+ $x[45]++;
+ },
+
+ sub
+ {
+ my $x = shift && return;
+ $x[46]++;
+ },
+
+ sub
+ {
+ my $x = shift;
+ for my $y (1 .. 2)
+ {
+ my $z = $x || last;
+ $x[47]++;
+ }
+ },
+
+ sub
+ {
+ my $x = shift;
+ for my $y (1 .. 2)
+ {
+ my $z = $x || next;
+ $x[48]++;
+ }
+ },
+
+ sub
+ {
+ my $x = shift;
+ for my $y (1 .. 2)
+ {
+ my $z = $x++ || redo;
+ $x[49]++;
+ }
+ },
+
+ sub
+ {
+ my $x = shift;
+ for my $y (1 .. 2)
+ {
+ my $z = $x || goto GR;
+ $x[50]++;
+ }
+GR:
+ },
+
+ sub
+ {
+ my $x = shift;
+ for my $y (1 .. 2)
+ {
+ eval { my $z = $x || die };
+ $x[51]++;
+ }
+ },
);
for my $s (@s)
@@ -10,7 +10,7 @@
use strict;
use warnings;
-use Devel::Cover::Test 0.68;
+use Devel::Cover::Test 0.69;
my $run_test = sub
{
@@ -10,7 +10,7 @@
use strict;
use warnings;
-use Devel::Cover::Test 0.68;
+use Devel::Cover::Test 0.69;
my $run_test = sub
{
@@ -12,8 +12,8 @@ use warnings;
use File::Copy;
-use Devel::Cover::Inc 0.68;
-use Devel::Cover::Test 0.68;
+use Devel::Cover::Inc 0.69;
+use Devel::Cover::Test 0.69;
my $base = $Devel::Cover::Inc::Base;